home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / STRINGS.SWG / 0078_Complete String Unit.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  5KB  |  215 lines
  1. UNIT Strings;
  2.  
  3. INTERFACE
  4.  
  5. USES
  6.    CRT,         {Import TextColor,TextBackGround}
  7.    DOS;         {Import FSplit,PathStr,NameStr,ExtStr,DirStr}
  8.  
  9. TYPE
  10.    TDir = (L,R);
  11.  
  12.  
  13. FUNCTION  Str2Int(Str: String; (* Converts String to Integer *)
  14.                   VAR Code: Integer): Integer;
  15. FUNCTION  Int2Str(I: Integer): String; (* Converts Integer to String *)
  16. FUNCTION  StripSlash(Str: String): String; (* String trailing '\' *)
  17. FUNCTION  AddSlash(Str: String): String; (* Add trailing '\' *)
  18. FUNCTION  PadStr(Str: String; (* Pad String with characters *)
  19.                  Ch: Char; (* Character to pad with *)
  20.                  Num: Byte; (* Number of places to pad to *)
  21.                  Dir: TDir): String; (* Direction to pad in *)
  22. FUNCTION  UpCaseStr(Str: String): String; (* Convert string to uppercase *)
  23. FUNCTION  LowCaseStr(Str: String): String; (* Convert string to lowercase *)
  24. FUNCTION  NameForm(Str: String): String; (* Convert string to Name format *)
  25. FUNCTION  StripExt(Str: String): String; (* Strip Extension from filename *)
  26. FUNCTION  AddExt(Str,Ext: String): String; (* Add Extension to filename *)
  27. FUNCTION  ExtractFName(Str: String): String; (* Extract Filename *)
  28. FUNCTION  ExtractFExt(Str: String): String; (* Extract file extension *)
  29. PROCEDURE Pipe(Str: String); (* Write string allowing for pipe codes *)
  30.  
  31.  
  32. IMPLEMENTATION
  33.  
  34.  
  35. FUNCTION  Str2Int(Str: String;
  36.                   VAR Code: Integer): Integer;
  37. VAR I: Integer;
  38.  
  39. BEGIN
  40.    VAL(Str,I,Code);
  41.    Str2Int := I;
  42. END;
  43.  
  44.  
  45. FUNCTION  Int2Str(I: Integer): String;
  46. VAR S: String;
  47.  
  48. BEGIN
  49.    STR(I,S);
  50.    Int2Str := S;
  51. END;
  52.  
  53.  
  54. FUNCTION  StripSlash(Str: String): String;
  55.  
  56. BEGIN
  57.    IF Str[Length(Str)] = '\' THEN
  58.     StripSlash := COPY(Str,1,Length(Str)-1);
  59. END;
  60.  
  61.  
  62. FUNCTION  AddSlash(Str: String): String;
  63.  
  64. BEGIN
  65.    IF Str[Length(Str)] <> '\' THEN
  66.     AddSlash := Str + '\';
  67. END;
  68.  
  69.  
  70. FUNCTION  PadStr(Str: String;
  71.                  Ch: Char;
  72.                  Num: Byte;
  73.                  Dir: TDir): String;
  74. VAR
  75.    TempStr: String;
  76.    B: Byte;
  77.  
  78. BEGIN
  79.    TempStr := '';
  80.    IF Length(Str) < Num THEN
  81.     BEGIN
  82.        FOR B := Length(Str) TO Num DO TempStr := TempStr + Ch;
  83.        CASE Dir OF
  84.           L: PadStr := TempStr + Str;
  85.           R: PadStr := Str + TempStr;
  86.        END;
  87.     END
  88.    ELSE
  89.     BEGIN
  90.        FOR B := 1 TO Num DO TempStr := TempStr + Str[B];
  91.        PadStr := TempStr;
  92.     END;
  93. END;
  94.  
  95.  
  96. FUNCTION  UpCaseStr(Str: String): String;
  97. VAR
  98.    TempStr: String;
  99.    B: Byte;
  100.  
  101. BEGIN
  102.    TempStr := Str;
  103.    FOR B := 1 TO Length(Str) DO TempStr[B] := UpCase(TempStr[B]);
  104.    UpCaseStr := TempStr;
  105. END;
  106.  
  107.  
  108. FUNCTION  LowCaseStr(Str: String): String;
  109. VAR
  110.    TempStr: String;
  111.    B: Byte;
  112.  
  113. BEGIN
  114.    TempStr := Str;
  115.    FOR B := 1 TO Length(Str) DO IF TempStr[B] IN ['A'..'Z'] THEN
  116.     TempStr[B] := CHR(ORD(TempStr[B])+32);
  117.    LowCaseStr := TempStr;
  118. END;
  119.  
  120.  
  121. FUNCTION  NameForm(Str: String): String;
  122. VAR
  123.    TempStr: String;
  124.    Pos: Byte;
  125.  
  126. BEGIN
  127.    TempStr := Str;
  128.    TempStr[1] := UpCase(TempStr[1]);
  129.    FOR Pos := 2 TO Length(TempStr) DO
  130.     IF TempStr[Pos] = #32 THEN
  131.      TempStr[Pos+1] := UpCase(TempStr[Pos+1])
  132.     ELSE
  133.      IF TempStr[Pos] IN ['A'..'Z'] THEN
  134.       TempStr[Pos] := CHR(ORD(TempStr[Pos])+32);
  135.    NameForm := TempStr;
  136. END;
  137.  
  138.  
  139. FUNCTION  StripExt(Str: String): String;
  140. VAR DotPos: Byte;
  141.  
  142. BEGIN
  143.    DotPos := POS('.',Str);
  144.    IF DotPos > 1 THEN StripExt := COPY(Str,1,DotPos-1)
  145.    ELSE StripExt := Str;
  146. END;
  147.  
  148.  
  149. FUNCTION  AddExt(Str,Ext: String): String;
  150. VAR DotPos: Byte;
  151.  
  152. BEGIN
  153.    DotPos := POS('.',Str);
  154.    IF (DotPos > 1) AND (DotPos < 10) THEN AddExt := COPY(Str,1,DotPos) + Ext
  155.    ELSE IF DotPos = 0 THEN AddExt := Str + '.' + Ext;
  156. END;
  157.  
  158.  
  159. FUNCTION  ExtractFName(Str: String): String;
  160. VAR
  161.    Path: PathStr;
  162.    Dir: DirStr;
  163.    Name: NameStr;
  164.    Ext: ExtStr;
  165.  
  166. BEGIN
  167.    Path := Str;
  168.    FSplit(Path,Dir,Name,Ext);
  169.    ExtractFName := Name+Ext;
  170. END;
  171.  
  172.  
  173. FUNCTION  ExtractFExt(Str: String): String;
  174. VAR
  175.    Path: PathStr;
  176.    Dir: DirStr;
  177.    Name: NameStr;
  178.    Ext: ExtStr;
  179.  
  180. BEGIN
  181.    Path := Str;
  182.    FSplit(Path,Dir,Name,Ext);
  183.    ExtractFExt := Ext;
  184. END;
  185.  
  186.  
  187. PROCEDURE Pipe(Str: String);
  188. VAR
  189.    StrPos, Err: Integer;
  190.    Col: Byte;
  191.  
  192. BEGIN
  193.    StrPos := 1;
  194.    IF Length(Str) < 1 THEN Exit;
  195.    REPEAT
  196.       IF (Str[StrPos] = '|') THEN
  197.        BEGIN
  198.           Val(Copy(Str,StrPos+1,2),Col,Err);
  199.           IF (Err = 0) AND (Col IN [0..23]) THEN
  200.              IF Col IN [0..15] THEN TextColor(Col)
  201.              ELSE TextBackGround(Col-16);
  202.           Inc(StrPos,3);
  203.        END
  204.       ELSE
  205.        BEGIN
  206.           Write(Str[StrPos]);
  207.           Inc(StrPos);
  208.        END;
  209.    UNTIL (StrPos > Length(Str));
  210. END;
  211.  
  212.  
  213. BEGIN
  214. END.
  215.